02-elaboration exploration basics

Elaboration/exploration analyses

## Loading the packages and data
library(dispRity)
load(file = "../Data/Processed/trees_list.rda")
load(file = "../Data/Processed/spaces_list.rda")

Endler’s style (basics)

image source

The basic idea is to measure the elaboration as the projection of observations (species) on a base vector (e.g. a1 the projection of a on b) and the exploration as the rejection from the base vector (e.g. a2 the rejection of a from b). Each observation can then be described in 2D with a elaboration score (the higher the absolute value of the score, the more the species is an elaborator - in both directions of b) and a exploration score (the higher, the more they explore). Of course we do that in any number of dimensions (not just 2!) and we’re going to play with the meaning of vector b (the base vector).

We can play around with it with these two spaces by defining a vector that is spanning from the 25%th quantile to the 75% quantile of all data (the 50% “average”ish axis).

## Getting the base vectors for both groups
psita_vector <- apply(spaces_list$psittaciformes, 2, quantile, prob = c(0.025, 0.975))
chara_vector <- apply(spaces_list$charadriiformes, 2, quantile, prob = c(0.025, 0.975))

## Calculating the projections/rejections for both groups
psita_proj <- projections(spaces_list$psittaciformes, point1 = psita_vector[1,], point2 = psita_vector[2, ])
psita_reje <- projections(spaces_list$psittaciformes, point1 = psita_vector[1,], point2 = psita_vector[2, ], measure = "distance")
chara_proj <- projections(spaces_list$charadriiformes, point1 = chara_vector[1,], point2 = chara_vector[2, ])
chara_reje <- projections(spaces_list$charadriiformes, point1 = chara_vector[1,], point2 = chara_vector[2, ], measure = "distance")

## A function for identifying and plotting the top explorer/elaborators names (for checking)
identify.tops <- function(scores, data, prob = 0.99, plot = FALSE, ...) {
    ## Get the tops
    tops <- which(scores >= quantile(scores, prob = prob))
    ## Get their names
    top_names <- rownames(data)[tops]
    if(plot) {
        text(data[tops,], labels = top_names, ...)
    }
    return(top_names)
}


par(mfrow = c(3, 2))
plot(spaces_list$psittaciformes[, 1:2], col = "blue", main = "Psittaciformes section of the shape space", xlab = "PC1 (unscaled)", ylab = "PC2 (unscaled)", pch = 19)

arrows(x0 = psita_vector[1,1], y0 = psita_vector[1,2],
       x1 = psita_vector[2,1], y1 = psita_vector[2,2], col = "black", lwd = 4)

plot(spaces_list$charadriiformes[, 1:2], col = "orange", main = "Psittaciformes section of the shape space", xlab = "PC1 (unscaled)", ylab = "PC2 (unscaled)", pch = 19)

arrows(x0 = chara_vector[1,1], y0 = chara_vector[1,2],
       x1 = chara_vector[2,1], y1 = chara_vector[2,2], col = "black", lwd = 4)

## The elaboration/exploration profiles
plot(psita_proj, psita_reje, pch = 19, col = "blue",
    xlab = "Elaboration", ylab = "Exploration", main = "Psittaciformes explo/elaboration profile")
plot(chara_proj, chara_reje, pch = 19, col = "orange",
    xlab = "Elaboration", ylab = "Exploration", main = "Charadriiformes explo/elaboration profile")

## The elaboration/exploration profiles
plot(abs(psita_proj), psita_reje, pch = 19, col = "blue",
    xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Psittaciformes explo/elaboration profile")

plot(abs(chara_proj), chara_reje, pch = 19, col = "orange",
    xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Charadriiformes explo/elaboration profile")

## Making a top table
psita_tops_proj <- identify.tops(score = abs(psita_proj), data = spaces_list$psittaciformes)
psita_tops_reje <- identify.tops(score = psita_reje, data = spaces_list$psittaciformes)
chara_tops_proj <- identify.tops(score = abs(chara_proj), data = spaces_list$charadriiformes)
chara_tops_reje <- identify.tops(score = chara_reje, data = spaces_list$charadriiformes)


## Making a top table
psita_top_proj <- identify.tops(score = abs(psita_proj), data = spaces_list$psittaciformes, prob = 1)
psita_top_reje <- identify.tops(score = psita_reje, data = spaces_list$psittaciformes, prob = 1)
chara_top_proj <- identify.tops(score = abs(chara_proj), data = spaces_list$charadriiformes, prob = 1)
chara_top_reje <- identify.tops(score = chara_reje, data = spaces_list$charadriiformes, prob = 1)

The top 99% elaborators are:

• parrots: Cacatua_tenuirostris, Nestor_meridionalis, Nestor_notabilis, Probosciger_aterrimus

• sea gulls: Gallinago_hardwickii, Gallinago_nemoricola, Gallinago_undulata, Limnodromus_semipalmatus

The top 99% explorers are:

• parrots: Anodorhynchus_leari, Enicognathus_leptorhynchus, Micropsitta_pusio, Nestor_notabilis

• sea gulls: Eurynorhynchus_pygmeus, Fratercula_arctica, Fratercula_cirrhata, Fratercula_corniculata

With our tops for each category:

Does this kind of works? Also this is nothing major, different or special compared to just picking species based on PC scores. The minor bonus here are:

• it can make the data slightly more interpretable if the base vector is well defined (e.g. in colour space this vector can be the “pure” color vector, etc…).
• it’s a useful flattening of a multidimensional space: although the first 2 PC in this dataset illustrate 85.1% of the variance, it’s still missing 228 other dimensions (including the “duck axis”!); also in palaeo data where PC1 and 2 bearly make up 1% of the data that’s a much better tool for visualising everything.

I guess the key thing is determining the exploration/elaboration vector. We can add some evo perspective to all of these by making the base vector “evolutionary” and by looking at elaboration/exploration through time!

Annex: some potentially interesting ratio thingy

## Loading the whole shape space
shapespace <- readRDS("../Data/Raw/Beak_data/2020_08_07_MMB_MORPHO_SHAPESPACE_FULL.rds")$PCscores
## Getting the vector from that space
space_vector <- apply(shapespace, 2, quantile, prob = c(0.025, 0.975))
psita_space_proj <- projections(spaces_list$psittaciformes, point1 = space_vector[1,], point2 = space_vector[2, ])
psita_space_reje <- projections(spaces_list$psittaciformes, point1 = space_vector[1,], point2 = space_vector[2, ], measure = "distance")
chara_space_proj <- projections(spaces_list$charadriiformes, point1 = space_vector[1,], point2 = space_vector[2, ])
chara_space_reje <- projections(spaces_list$charadriiformes, point1 = space_vector[1,], point2 = space_vector[2, ], measure = "distance")
## Groups
group <- list("Psittaciformes" = trees_list$psittaciformes[[1]]$tip.label,
              "Charadriiformes" = trees_list$charadriiformes[[1]]$tip.label,
              "Others" = rownames(shapespace)[!(rownames(shapespace) %in% c(trees_list$psittaciformes[[1]]$tip.label, trees_list$charadriiformes[[1]]$tip.label))])
## Full space plot
plot(custom.subsets(shapespace, group = group), col = c("blue", "orange", "grey"), pch = c(19, 19, 21), main = "Bird beak shape space")
arrows(x0 = space_vector[1,1], y0 = space_vector[1,2],
       x1 = space_vector[2,1], y1 = space_vector[2,2], col = "black", lwd = 4)

par(mfrow = c(2, 2))
## The elaboration/exploration profiles
plot(psita_space_proj, psita_space_reje, pch = 19, col = "blue",
    xlab = "Elaboration", ylab = "Exploration", main = "Psitta explo/elaboration profile (total)")
plot(chara_space_proj, chara_space_reje, pch = 19, col = "orange",
    xlab = "Elaboration", ylab = "Exploration", main = "Chara explo/elaboration profile (total)")

## The elaboration/exploration profiles
plot(abs(psita_space_proj), psita_space_reje, pch = 19, col = "blue",
    xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Psitta explo/elaboration profile (total)")
plot(abs(chara_space_proj), chara_space_reje, pch = 19, col = "orange",
    xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Chara explo/elaboration profile (total)")

Meh… But we can also do ratios: the one between the within group elaboration/exploration and the total elaboration/exploration. This can help us find the big time explorers/elaborators? (here: the one in the top 99% CI)

## Get the ratio
reje_ratio <- psita_reje/psita_space_reje
proj_ratio <- abs(psita_proj)/abs(psita_space_proj)

## Find the 99% top explorers/elaborators
top_explo <- which(reje_ratio >= quantile(reje_ratio, prob = 0.99))
top_elab <- which(proj_ratio >= quantile(proj_ratio, prob = 0.99))
top_explo_names <- rownames(spaces_list$psittaciformes)[top_explo]
top_elab_names <- rownames(spaces_list$psittaciformes)[top_elab]

plot(proj_ratio, reje_ratio, pch = 19, col = "blue",
    xlab = "Group/space elaboration", ylab = "Group/space exploration", main = "Psittaciformes")
text(cbind(proj_ratio, reje_ratio)[top_explo, ], labels = top_explo_names, pos = 4)
text(cbind(proj_ratio, reje_ratio)[top_elab, ], labels = top_elab_names, pos = 1)

## Get the ratio
reje_ratio <- chara_reje/chara_space_reje
proj_ratio <- abs(chara_proj)/abs(chara_space_proj)

## Find the 99% top explorers/elaborators
top_explo <- which(reje_ratio >= quantile(reje_ratio, prob = 0.99))
top_elab <- which(proj_ratio >= quantile(proj_ratio, prob = 0.99))
top_explo_names <- rownames(spaces_list$charadriiformes)[top_explo]
top_elab_names <- rownames(spaces_list$charadriiformes)[top_elab]

plot(proj_ratio, reje_ratio, pch = 19, col = "orange",
    xlab = "Group/space elaboration", ylab = "Group/space exploration", main = "Charadriiformes")
text(cbind(proj_ratio, reje_ratio)[top_explo, ], labels = top_explo_names, pos = 4)
text(cbind(proj_ratio, reje_ratio)[top_elab, ], labels = top_elab_names, pos = 1)

Maybe it’s picking up some weird birds…